home *** CD-ROM | disk | FTP | other *** search
/ Macwelt 1 / Macwelt DVD 1.toast / Web-Publishing / HTML-Editoren / Alpha ƒ / Tcl / SystemCode / CorePackages / filesets.tcl < prev    next >
Encoding:
Text File  |  2001-02-07  |  34.2 KB  |  1,168 lines
  1. ## -*-Tcl-*-
  2.  # ###################################################################
  3.  #  AlphaTcl - core Tcl engine
  4.  # 
  5.  #    FILE: "filesets.tcl"
  6.  #                    created: 20/7/96 {6:22:25 pm} 
  7.  #                   last update: 2/7/2001 {9:20:49 PM} 
  8.  #    Author:    Vince Darley
  9.  #    E-mail:    <vince@santafe.edu>
  10.  #      mail:    317 Paseo de Peralta, Santa Fe, NM 87501, USA
  11.  #       www:    <http://www.santafe.edu/~vince/>
  12.  #    
  13.  #==============================================================================
  14.  # Alpha calls two fileset-related routines, 'getCurrFileSet', and 
  15.  # 'getFileSetNames'. Alpha will also attempt to set the variable 'currFileSet'
  16.  # on occasion, but this isn't critical.
  17.  #==============================================================================
  18.  # 
  19.  # This file, and the interfaces it contains are undergoing some
  20.  # development.  The APIs may undergo minor changes in the future,
  21.  # as we learn more about how users want to interact with filesets.
  22.  # Code contributions and suggestions are very welcome.
  23.  # ###################################################################
  24.  ##
  25.  
  26. alpha::extension filesets 1.0fc1 {
  27.     # Something in here must ensure this file is sourced.
  28.     
  29.     # Build some filesets on the fly.
  30.     set gfileSets(Help) [list [file join $HOME Help *] 3]
  31.     # Declare their types
  32.     set gfileSetsType(Help) "fromHierarchy"
  33.     filesetRegisterProcedural "Open Windows" procFilesetOpenWindows
  34.     filesetRegisterProcedural "Top Window's Folder" procFilesetDirTopWin
  35.     filesetRegisterProcedural "Top Window's Hierarchy" procFilesetHierarchyTopWin
  36.     filesetRegisterProcedural "Recurse in folder…" procFilesetRecurseIn
  37.     lunion varPrefs(Files) currFileSet
  38.     # The current fileset is used as a default for some actions.  It may
  39.     # also be updated automatically to reflect the user's most recent
  40.     # fileset-menu selection.
  41.     newPref var currFileSet "Top Window's Folder" global changeFileSet gfileSets array
  42.  
  43.     ## 
  44.      # A type is a means of prompting the user and characterising
  45.      # the interface to a type, even though the actual storage may be
  46.      # very simple (a list in most cases).
  47.      ##
  48.     fileset::registerNewType fromDirectory "glob"
  49.     fileset::registerNewType fromHierarchy "fromHierarchy"
  50.     fileset::registerNewType fromOpenWindows "list"
  51.     fileset::registerNewType procedural "procedural"
  52.     fileset::registerNewType recurseIn "procedural"
  53.  
  54.     set fileset::notChangeable [list "Open Windows" \
  55.       "Top Window's Folder" "Top Window's Hierarchy" \
  56.       "Recurse in folder…"]
  57.  
  58.     prefs::modified currFileSet
  59.  
  60.     hook::register preOpeningHook fileset::checkOpeningPreference
  61.     
  62.     # Make sure our preferences are ok.
  63.     foreach fset [array names gfileSets] {
  64.     if {![info exists gfileSetsType($fset)]} {
  65.         lappend fsetErrors $fset
  66.         unset gfileSets($fset)
  67.         prefs::modified gfileSets($fset)
  68.     }
  69.     }
  70.     if {[info exists fsetErrors]} {
  71.     alertnote "[join $fsetErrors {, }] filesets were corrupted, and have\
  72.       been removed"
  73.     unset fsetErrors
  74.     }
  75.     if {[info exists fset]} {unset fset}
  76. } maintainer {
  77.     "Vince Darley" vince@santafe.edu <http://www.santafe.edu/~vince/>
  78. } help {file "Filesets Help"}
  79.  
  80. # Register utilities
  81.  
  82. set    "filesetUtils(browseFileset…)" [list * browseFileset]
  83. set    "filesetUtils(renameFileset…)" [list * renameFileset]
  84. set    "filesetUtils(openEntireFileset…)" [list * openEntireFileset]
  85. set    "filesetUtils(filesetToAlpha…)" [list * filesetToAlpha]
  86. set    "filesetUtils(closeEntireFileset…)" [list * closeEntireFileset]
  87. set    "filesetUtils(replaceInFileset…)" [list * replaceInFileset]
  88. set    "filesetUtils(stuffFileset…)" [list * stuffFileset]
  89. set    "filesetUtils(wordCount)" [list * wordCountFileset]
  90. set    "filesetUtils(openFilesetFolder…)" [list * openFilesetFolder]
  91.  
  92. # ◊◊◊◊ Filesets API ◊◊◊◊ #
  93.  
  94. # A fileset has a few key properties:
  95. # 
  96. # (i) a name
  97. # (ii) a way of testing whether any given file is in that fileset
  98. # (iii) a way of listing all files in the fileset
  99. # (iv) a 'basic type', which is currently any of: 
  100. # 'list'
  101. # 'procedural'
  102. # 'glob'
  103. # 'fromHierarchy'
  104. # 
  105. # It may also have any number of other properties, usually added by
  106. # other packages.  For instance, the filesets menu will add a flag
  107. # declaring whether a fileset is shown in the menu.
  108.  
  109. ## 
  110.  # To add a new fileset type, you need to define the following:
  111.  #       fileset::registerNewType myType "list"
  112.  #       proc    fileset::myType::create {} {}
  113.  #       proc    fileset::myType::updateContents {name {andMenu 0}} {}
  114.  # 
  115.  # For more complex types (e.g. the tex-type), also define:
  116.  #       proc    fileset::myType::selected {fset menu item } {}
  117.  #       proc    fileset::myType::listFiles {name} {}
  118.  # 
  119.  # For filesets you want to make easily editable via the 'editFilesets'
  120.  # dialog, you must also define:
  121.  #       proc    fileset::myType::getDialogItems {name} {}
  122.  #       proc    fileset::myType::setDetails {name args} {}
  123.  # 
  124.  # These procedures will all be called automatically under the correct
  125.  # circumstances.  The purposes of these are as follows:
  126.  #
  127.  #   'create'   -- query the user for name etc. and create
  128.  #   'updateContents'   -- given the information in 'gfileSets', recalculate
  129.  #                   the member files.
  130.  #   'selected' -- a member was selected in a menu.
  131.  #   'listFiles'     -- given info in all except 'fileSets', return list
  132.  #                 of files to be stored in that variable.
  133.  #   'makeFileSetAndMenu'  -- generate the sub-menu
  134.  # 
  135.  # Your code may wish to call 'isWindowInFileset ?win?  ?type?'  to
  136.  # check if a given (current by default) window is in a fileset of a
  137.  # given type.
  138.  ##
  139.  
  140.  
  141. namespace eval fileset {}
  142.  
  143. ## 
  144.  # -------------------------------------------------------------------------
  145.  # 
  146.  # "fileset::registerNewType" --
  147.  # 
  148.  #  Add a new type of fileset to the list of known types.  Having
  149.  #  called this procedure, Alpha will automatically know how to interact
  150.  #  with the new fileset type, provided it fulfills the fileset API.
  151.  #  
  152.  #  This requires the existence of the procs:
  153.  #  
  154.  #    'fileset::$type::create'
  155.  #    'fileset::$type::updateContents'
  156.  #    
  157.  #  Note that the namespace 'fileset::$type' is automatically created
  158.  #  by this procedure.
  159.  #  
  160.  #  Filesets which you want to make editable in the 'Edit Filesets' 
  161.  #  dialog must also define the procs
  162.  #  
  163.  #       proc    fileset::$type::getDialogItems {name}
  164.  #       proc    fileset::$type::setDetails {name args}
  165.  #  
  166.  # -------------------------------------------------------------------------
  167.  ##
  168. proc fileset::registerNewType {type kind} {
  169.     global fileset::typeKindMap
  170.     set fileset::typeKindMap($type) $kind
  171.     # Make sure this namespace exists
  172.     namespace eval ::fileset::$type {}
  173. }
  174.  
  175. ## 
  176.  # -------------------------------------------------------------------------
  177.  # 
  178.  # "fileset::attachNewInformation" --
  179.  # 
  180.  #  If 'to' is '*' then this item is automatically attached to all filesets,
  181.  #  if not then each fileset may individually select whether to attach
  182.  #  this information or not.  This selection is done by the user, via the
  183.  #  'Attach/Detach info' button in the 'Edit A Fileset' dialog.
  184.  # -------------------------------------------------------------------------
  185.  ##
  186. proc fileset::attachNewInformation {to infoType name {defaultValue ""} {help ""} {modifiedScript ""}} {
  187.     global fileset::infoTypes gfileSets fileset::infoStorage
  188.     set fileset::infoTypes($name) [list $to $name $infoType $defaultValue $help $modifiedScript]
  189.     foreach fset [array names gfileSets] {
  190.     if {![info exists fileset::infoStorage($fset,$name)]} {
  191.         set fileset::infoStorage($fset,$name) $defaultValue
  192.         if {[string length $modifiedScript]} {
  193.         eval $modifiedScript [list $fset $defaultValue]
  194.         }
  195.     }
  196.     }
  197. }
  198.  
  199. proc fileset::ensureAllInfoAttached {fsets infoNames} {
  200.     global fileset::infoTypes gfileSets fileset::infoStorage
  201.     if {![llength $fsets]} { set fsets [array names gfileSets] }
  202.     if {![llength $infoNames]} { set infoNames [array names fileset::infoTypes] }
  203.     foreach infoName $infoNames {
  204.     set defaultValue [lindex [set fileset::infoTypes($infoName)] 3]
  205.     set modifiedScript [lindex [set fileset::infoTypes($infoName)] 5]
  206.     foreach fset $fsets {
  207.         if {![info exists fileset::infoStorage($fset,$infoName)]} {
  208.         set fileset::infoStorage($fset,$infoName) $defaultValue
  209.         if {[string length $modifiedScript]} {
  210.             eval $modifiedScript [list $fset $defaultValue]
  211.         }
  212.         }
  213.     }
  214.     }
  215. }
  216.  
  217. proc fileset::isAttached {fset name} {
  218.     global fileset::attachments
  219.     if {[info exists fileset::attachments($fset,$name)]} {
  220.     return [set fileset::attachments($fset,$name)]
  221.     } else {
  222.     return 0
  223.     }
  224. }
  225.  
  226. proc fileset::chooseAttachments {fset} {
  227.     global fileset::infoTypes
  228.     set items {}
  229.     foreach name [array names fileset::infoTypes] {
  230.     set val [set fileset::infoTypes($name)]
  231.     if {[lindex $val 0] == "*"} {
  232.         # always attached
  233.         continue
  234.     } else {
  235.         lappend items $name [fileset::isAttached $fset $name]
  236.     }
  237.     }
  238.     if {![llength $items]} {
  239.     alertnote "No items exist which can be attached"
  240.     return
  241.     }
  242.     set x 10
  243.     set y 10
  244.     eval lappend dialog [dialog::text "Checked items are currently attached" 10 y]
  245.     incr y 10
  246.     newforeach {name val} $items {
  247.     eval lappend dialog [dialog::checkbox $name $val 10 y]
  248.     }
  249.     incr y 10
  250.     set dialog [concat [dialog::okcancel 10 y] $dialog]
  251.     set res [eval [list dialog -w 360 -h $y] $dialog]
  252.     if {[lindex $res 1]} {
  253.     return "Cancelled"
  254.     }
  255.     set count 2
  256.     global fileset::attachments
  257.     set mod 0
  258.     newforeach {name val} $items {
  259.     set newval [lindex $res $count]
  260.     if {$newval != $val} {
  261.         set mod 1
  262.         if {$newval} {
  263.         set fileset::attachments($fset,$name) 1
  264.         } else {
  265.         unset fileset::attachments($fset,$name)
  266.         }
  267.         prefs::modified fileset::attachments($fset,$name)
  268.     }
  269.     incr count
  270.     }
  271.     if {$mod} {
  272.     alertnote "The next time you use the 'Edit Filesets' or \
  273.       'Edit A Fileset' dialog, these changes will take effect."
  274.     }
  275.     return "Done"
  276. }
  277.  
  278. proc fileset::informationAttached {fset} {
  279.     global fileset::infoTypes
  280.     set res {}
  281.     foreach name [array names fileset::infoTypes] {
  282.     set val [set fileset::infoTypes($name)]
  283.     if {[lindex $val 0] == "*" || [fileset::isAttached $fset $name]} {
  284.         lappend res [lrange $val 1 end]
  285.     }
  286.     }
  287.     return $res
  288. }
  289.  
  290. ## 
  291.  # -------------------------------------------------------------------------
  292.  # 
  293.  # "fileset::attachAdditionalInformation" --
  294.  # 
  295.  #  Attach a piece of information which is only shown to the user if
  296.  #  the fileset's $toInfoName has the current value $toVal.  Note,
  297.  #  however, that the information is actually attached to all filesets,
  298.  #  it is only the visibility to the user that is adjusted.
  299.  # -------------------------------------------------------------------------
  300.  ##
  301. proc fileset::attachAdditionalInformation {toInfoName toVal infoType name {defaultValue ""} {help ""} {modifiedScript ""}} {
  302.     global fileset::infoAdditionalTypes gfileSets fileset::infoStorage
  303.     lappend fileset::infoAdditionalTypes($toInfoName,$toVal) [list $name $infoType $defaultValue $help $modifiedScript]
  304.     foreach fset [array names gfileSets] {
  305.     if {![info exists fileset::infoStorage($fset,$name)]} {
  306.         set fileset::infoStorage($fset,$name) $defaultValue
  307.         if {[string length $modifiedScript]} {
  308.         eval $modifiedScript [list $fset $defaultValue]
  309.         }
  310.     }
  311.     }
  312. }
  313.  
  314. proc fileset::additionalInformationAttached {fset infoName val} {
  315.     global fileset::infoAdditionalTypes
  316.     if {[info exists fileset::infoAdditionalTypes($infoName,$val)]} {
  317.     return [set fileset::infoAdditionalTypes($infoName,$val)]
  318.     }
  319.     return ""
  320. }
  321.  
  322. proc fileset::makeInfoDialogItems {fset yy} {
  323.     upvar $yy y
  324.     set res {}
  325.     foreach pair [fileset::informationAttached $fset] {
  326.     set name [lindex $pair 0]
  327.     set infoType [lindex $pair 1]
  328.     set val [fileset::getInformation $fset $name]
  329.     eval lappend res [dialog::makeItem $infoType 20 y $fset $name $val]
  330.     }
  331.     set res
  332. }
  333.  
  334. proc fileset::getInfoDialogItems {fset} {
  335.     set res {}
  336.     foreach pair [fileset::informationAttached $fset] {
  337.     set name [lindex $pair 0]
  338.     set infoType [lindex $pair 1]
  339.     set val [fileset::getInformation $fset $name]
  340.     lappend res [list $infoType $name $val [lindex $pair 3]]
  341.     foreach additionalPair [fileset::additionalInformationAttached $fset $name $val] {
  342.         set name [lindex $additionalPair 0]
  343.         set infoType [lindex $additionalPair 1]
  344.         set val [fileset::getInformation $fset $name]
  345.         lappend res [list $infoType $name $val [lindex $additionalPair 3]]
  346.     }
  347.     }
  348.     set res
  349. }
  350.  
  351. proc fileset::setInfoFromDialog {fset count res} {
  352.     foreach pair [fileset::informationAttached $fset] {
  353.     set name [lindex $pair 0]
  354.     set infoType [lindex $pair 1]
  355.     set oldVal [fileset::getInformation $fset $name]
  356.     set val [lindex $res $count]
  357.     fileset::setInformation $fset $name $val
  358.     incr count
  359.     foreach additionalPair [fileset::additionalInformationAttached $fset $name $oldVal] {
  360.         set name [lindex $additionalPair 0]
  361.         set infoType [lindex $additionalPair 1]
  362.         set val [lindex $res $count]
  363.         fileset::setInformation $fset $name $val
  364.         incr count
  365.     }
  366.     }
  367.     return $count
  368. }
  369.  
  370. ## 
  371.  # -------------------------------------------------------------------------
  372.  # 
  373.  # "fileset::listTypes" --
  374.  # 
  375.  #  Return sorted list of all fileset types currently registered.  This
  376.  #  is used, for example, when creating a new fileset, so that we may
  377.  #  ask the user to select the type of fileset they wish to create.
  378.  # -------------------------------------------------------------------------
  379.  ##
  380. proc fileset::listTypes {} {
  381.     global fileset::typeKindMap
  382.     lsort -ignore [array names fileset::typeKindMap]
  383. }
  384.  
  385. proc fileset::getKind {type} {
  386.     global fileset::typeKindMap
  387.     set fileset::typeKindMap($type)
  388. }
  389.  
  390. proc fileset::getKindFromFset {fset} {
  391.     global gfileSetsType fileset::typeKindMap
  392.     set fileset::typeKindMap($gfileSetsType($fset))
  393. }
  394.  
  395. proc fileset::getInformation {fset infoName} {
  396.     global fileset::infoStorage
  397.     if {![info exists fileset::infoStorage($fset,$infoName)]} {
  398.     # This should only happen if we create a fileset manually
  399.     # in Tcl by filling in the various array entries.
  400.     fileset::ensureAllInfoAttached [list $fset] [list]
  401.     }
  402.     set fileset::infoStorage($fset,$infoName)
  403. }
  404.  
  405. proc fileset::setInformation {fset infoName value} {
  406.     global fileset::infoStorage fileset::infoTypes
  407.     if {[info exists fileset::infoStorage($fset,$infoName)]} {
  408.     if {[set fileset::infoStorage($fset,$infoName)] != $value} {
  409.         set fileset::infoStorage($fset,$infoName) $value
  410.         prefs::modified fileset::infoStorage($fset,$infoName)
  411.         # This only fails for 'additional information'
  412.         if {[info exists fileset::infoTypes($infoName)]} {
  413.         set modifiedScript [lindex [set fileset::infoTypes($infoName)] 5]
  414.         if {[string length $modifiedScript]} {
  415.             eval $modifiedScript [list $fset $value]
  416.         }
  417.         }
  418.     }
  419.     } else {
  420.     set fileset::infoStorage($fset,$infoName) $value
  421.     }
  422. }
  423.  
  424. proc fileset::checkOpeningPreference {name} {
  425.     if {[hook::anythingRegistered fileset-file-opening]} {
  426.     set fset [fileset::findForFile $name]
  427.     if {[string length $fset]} {
  428.         hook::callAll fileset-file-opening * $fset $name
  429.     }
  430.     }
  431. }
  432.  
  433. proc fileset::checkCurrent {{win ""}} {
  434.     return [fileset::findForFile $win]
  435. }
  436.  
  437. proc fileset::relativePath {{win ""}} {
  438.     set fset [fileset::findForFile $win]
  439.     global gfileSets
  440.     set root [file dirname $gfileSets($fset)]
  441.     if {[file::pathStartsWith $win $root relative]} {
  442.     return $relative
  443.     } else {
  444.     error "Not relative"
  445.     }
  446. }
  447.  
  448. proc fileset::canEdit {fset} {
  449.     global gfileSetsType
  450.     set type $gfileSetsType($fset)
  451.     if {$type == "procedural"} {
  452.     return -1
  453.     }
  454.     if {[info commands fileset::${type}::getDialogItems] != ""} {
  455.     return 1
  456.     } else {
  457.     return [auto_load fileset::${type}::getDialogItems]
  458.     }
  459. }
  460.  
  461. proc filesetRegisterProcedural {name proc} {
  462.     global gfileSets gfileSetsType
  463.     set gfileSets($name) $proc
  464.     set gfileSetsType($name) "procedural"
  465. }
  466.  
  467.  
  468. # ◊◊◊◊ Basic procedures ◊◊◊◊ #
  469.  
  470. proc editFilesets {} {
  471.     global currFileSet gfileSetsType gfileSets 
  472.     
  473.     # Used to build up the items in the dialog
  474.     set dialog {}
  475.     # Used to store the original values of each fileset entry
  476.     set values {}
  477.     # Create a page for each editable fileset
  478.     foreach fset [lsort -ignore [array names gfileSets]] {
  479.     set canEdit [fileset::canEdit $fset]
  480.     if {$canEdit < 0} {continue}
  481.     set page [list $fset]
  482.     if {$canEdit} {
  483.         set thisfset_items [fileset::$gfileSetsType($fset)::getDialogItems $fset]
  484.         eval lappend page $thisfset_items
  485.         # Store a list of the current values
  486.         set vals [list]
  487.         foreach item $thisfset_items {
  488.         lappend vals [lindex $item 2]
  489.         }
  490.         lappend values $vals 
  491.     }
  492.     eval lappend page [fileset::getInfoDialogItems $fset]
  493.     lappend dialog $page
  494.     }
  495.     set res [eval [list dialog::make -title "Edit filesets" -defaultpage $currFileSet] $dialog]
  496.     # Now set everything
  497.     set stored_index 0
  498.     foreach fset [lsort -ignore [array names gfileSets]] {
  499.     set canEdit [fileset::canEdit $fset]
  500.     if {$canEdit < 0} {continue}
  501.     set count 0
  502.     if {$canEdit} {
  503.         set vals [lindex $values $stored_index]
  504.         set count [llength $vals]
  505.         set mod 0
  506.         for {set i 0} {$i < $count} {incr i} {
  507.         if {[lindex $vals $i] != [lindex $res $i]} {
  508.             set mod 1
  509.             break
  510.         }
  511.         }
  512.         # Only call the 'setDetails' proc if the fileset has changed.
  513.         if {$mod} {
  514.         message "Updating fileset $fset"
  515.         eval fileset::$gfileSetsType($fset)::setDetails [list $fset] [lrange $res 0 [expr {$count -1}]]
  516.         updateAFileset $fset
  517.         }
  518.         incr stored_index
  519.     }
  520.     set count [fileset::setInfoFromDialog $fset $count $res]
  521.     set res [lrange $res $count end]
  522.     }
  523.     message "Fileset changes complete"
  524. }
  525.  
  526. proc editAFileset {{fset ""}} {
  527.     if {[catch {pickFileset $fset "Edit which fileset?" editable} fset]} {return}
  528.     global currFileSet gfileSetsType gfileSets 
  529.     # Used to build up the items in the dialog
  530.     set dialog {}
  531.     # Used to store the original values of each fileset entry
  532.     set values {}
  533.     set page [list $fset]
  534.     set thisfset_items [fileset::$gfileSetsType($fset)::getDialogItems $fset]
  535.     eval lappend page $thisfset_items
  536.     # Store a list of the current values
  537.     set vals [list]
  538.     foreach item $thisfset_items {
  539.     lappend vals [lindex $item 2]
  540.     }
  541.     lappend values $vals 
  542.     eval lappend page [fileset::getInfoDialogItems $fset]
  543.     lappend dialog $page
  544.     set res [eval [list dialog::make -title "Edit '$fset' fileset" \
  545.       -addbuttons [list "Attach/detach info" "Click here to attach or detach optional\
  546.       additional information to this fileset" [list fileset::chooseAttachments $fset]]] $dialog]
  547.     # Now set everything
  548.     set stored_index 0
  549.     set count 0
  550.     set vals [lindex $values $stored_index]
  551.     set count [llength $vals]
  552.     set mod 0
  553.     for {set i 0} {$i < $count} {incr i} {
  554.     if {[lindex $vals $i] != [lindex $res $i]} {
  555.         set mod 1
  556.         break
  557.     }
  558.     }
  559.     # Only call the 'setDetails' proc if the fileset has changed.
  560.     if {$mod} {
  561.     message "Updating fileset $fset"
  562.     eval fileset::$gfileSetsType($fset)::setDetails [list $fset] [lrange $res 0 [expr {$count -1}]]
  563.     updateAFileset $fset
  564.     message "Fileset $fset updated"
  565.     }
  566.     incr stored_index
  567.     set count [fileset::setInfoFromDialog $fset $count $res]
  568.     set res [lrange $res $count end]
  569. }
  570.  
  571. proc newFileset {{type ""}} {
  572.     global currFileSet gfileSetsType
  573.     if {$type == ""} {
  574.     foreach ty [fileset::listTypes] {
  575.         lappend types [quote::Prettify $ty]
  576.     }
  577.     set type [dialog::optionMenu "New fileset type?" \
  578.       $types "From Directory"]
  579.     foreach ty [fileset::listTypes] {
  580.         if {[quote::Prettify $ty] == $type} {
  581.         set type $ty
  582.         break
  583.         }
  584.     }
  585.     }
  586.     set name [eval fileset::${type}::create]
  587.  
  588.     if {![string length $name]} return
  589.     
  590.     set gfileSetsType($name) $type
  591.     prefs::modified gfileSets($name)
  592.     
  593.     set currFileSet $name
  594.     hook::callAll fileset-new $gfileSetsType($name) $name
  595.     return $currFileSet
  596. }
  597.  
  598. proc deleteFileset {{fset ""} {yes 0}} {
  599.     global currFileSet 
  600.     
  601.     if {[catch {pickFileset $fset "Delete which Fileset?" "notbuiltin"} fset]} {
  602.     return
  603.     }
  604.     if {$fset == ""} {
  605.     message "The existing filesets cannot be deleted."
  606.     return
  607.     }
  608.  
  609.     global fileSets gfileSets fileSetsExtra gfileSetsType
  610.  
  611.     if {$yes || [dialog::yesno "Delete fileset \"$fset\"?"]} {
  612.     set type $gfileSetsType($fset)
  613.  
  614.     hook::callAll fileset-delete $type $fset
  615.  
  616.     fileset::uncache $fset
  617.     catch {unset "fileSetsExtra($fset)"}
  618.     catch {unset "gfileSetsType($fset)"}
  619.     catch {unset "fileSets($fset)"}
  620.     catch {unset "gfileSets($fset)"}
  621.     
  622.     # fileSets($fset) is stored not in the usual prefs location,
  623.     # but rather in the fsMenu2.0 cache, so we don't need to
  624.     # call prefs::modified with it.
  625.     prefs::modified gfileSetsType($fset) gfileSets($fset) \
  626.       fileSetsExtra($fset)
  627.     message "The fileset \"$fset\" has been deleted"
  628.  
  629.     if {$currFileSet == $fset} {
  630.         set old $currFileSet
  631.         catch {
  632.         set currFileSet [lindex [array names gfileSets] 0]
  633.         }
  634.         hook::callAll fileset-current * $old $currFileSet
  635.     }
  636.     }
  637. }
  638.  
  639. proc renameFileset {} {
  640.     global fileSets gfileSets currFileSet fileSetsExtra gfileSetsType
  641.     
  642.     if {[catch {pickFileset "" "Fileset to rename?" "notbuiltin"} fset]} {return}
  643.     if {$fset == ""} {
  644.     message "The existing filesets cannot be renamed."
  645.     return
  646.     }
  647.  
  648.     set name [getline "Rename to:" $fset]
  649.     if {![string length $name] || $name == $fset} return
  650.     
  651.     set gfileSets($name) $gfileSets($fset)
  652.     set gfileSetsType($name) $gfileSetsType($fset)
  653.     prefs::modified gfileSets($name) gfileSetsType($name)
  654.  
  655.     if {[info exists fileSets($fset)]} {
  656.     set fileSets($name) $fileSets($fset)
  657.     }
  658.     if {[info exists fileSetsExtra($fset)]} {
  659.     set fileSetsExtra($name) $fileSetsExtra($fset)
  660.     prefs::modified fileSetsExtra($name)
  661.     }
  662.     
  663.     deleteFileset $fset 1
  664.     
  665.     set currFileSet $name
  666.     hook::callAll fileset-new $gfileSetsType($name) $name
  667.     message "The fileset \"$fset\" has been renamed to \"$name\""
  668. }
  669.  
  670. proc updateCurrentFileset {} {
  671.     global currFileSet
  672.     updateAFileset $currFileSet
  673. }
  674.  
  675. proc updateAFileset { {fset ""} } {
  676.     global gfileSetsType
  677.  
  678.     if {[catch {pickFileset $fset} fset]} {return}
  679.     
  680.     fileset::uncache $fset
  681.     fileset::make $fset 1
  682. }
  683.  
  684. proc fileset::uncache {fset} {
  685.     global fsMenuCache
  686.     if {[info exists fsMenuCache($fset)]} {
  687.     unset fsMenuCache($fset)
  688.     cache::add fsMenu2.0 "eval" [list unset fsMenuCache($fset)]
  689.     }
  690.     hook::callAll fileset-uncache * $fset
  691. }
  692.  
  693. proc getFilesInSet {fset} {
  694.     global gfileSets gfileSetsType
  695.     switch -- [fileset::getKind $gfileSetsType($fset)] {
  696.     "list" {
  697.         return $gfileSets($fset)
  698.     }
  699.     "glob" {
  700.         global filesetmodeVars fileSetsExtra
  701.         if {$filesetmodeVars(includeNonTextFiles)} {
  702.         set l [glob -nocomplain -dir [file dirname "$gfileSets($fset)"] -- [file tail "$gfileSets($fset)"]]
  703.         if {[info exists fileSetsExtra($fset)]} {
  704.             foreach pat $fileSetsExtra($fset) {
  705.             foreach f [glob -nocomplain -dir [file dirname "$gfileSets($fset)"] -- $pat] {
  706.                 set i [lsearch $l $f]
  707.                 set l [lreplace $l $i $i]
  708.             }
  709.             }
  710.         }
  711.         return $l
  712.         } else {
  713.         set l [glob -types TEXT -nocomplain -dir [file dirname "$gfileSets($fset)"] -- [file tail "$gfileSets($fset)"]]
  714.         if {[info exists fileSetsExtra($fset)]} {
  715.             foreach pat $fileSetsExtra($fset) {
  716.             foreach f [glob -types TEXT -nocomplain -dir [file dirname "$gfileSets($fset)"] -- $pat] {
  717.                 set i [lsearch $l $f]
  718.                 set l [lreplace $l $i $i]
  719.             }
  720.             }
  721.         }
  722.         return $l
  723.         }
  724.     }
  725.     "procedural" {
  726.         switch -- $gfileSetsType($fset) {
  727.         "recurseIn" {
  728.             return [file::recurse [file dirname $gfileSets($fset)]]
  729.         }
  730.         default {
  731.             return [$gfileSets($fset)]
  732.         }
  733.         }
  734.     }        
  735.     "default" {
  736.         global fileSets
  737.         return $fileSets($fset)
  738.     }
  739.     }
  740. }
  741.  
  742. proc fileset::make {name andMenu} {
  743.     if {$andMenu} {
  744.     global fsMenuCache
  745.     if {[info exists fsMenuCache($name)]} {
  746.         set m [set fsMenuCache($name)]
  747.         if {[llength $m]} { return $m }
  748.     }
  749.     }
  750.  
  751.     global gfileSetsType fileSets
  752.     if {[info exists gfileSetsType($name)]} {
  753.     set type $gfileSetsType($name)
  754.     message "Building ${name}…"
  755.     if {![catch {fileset::${type}::updateContents $name $andMenu} m]} {
  756.         if {[llength $m]} {
  757.         fileset::cacheMenu $name $m
  758.         }
  759.         if {[info exists fileSets($name)]} {
  760.         cache::add fsMenu2.0 "variable" fileSets($name)
  761.         }
  762.         hook::callAll fileset-update $type $name $m
  763.         message "Building ${name}… complete"
  764.         return $m
  765.     } else {
  766.         # nothing
  767.     }
  768.     }
  769.     return [list]
  770. }
  771.  
  772. proc fileset::cacheMenu {fset m} {
  773.     if {[llength $m]} {
  774.     global fsMenuCache
  775.     set fsMenuCache($fset) $m
  776.     cache::add fsMenu2.0 variable fsMenuCache($fset)
  777.     }
  778. }
  779.  
  780. # Called in response to user changing filesets manually
  781. proc changeFileSet {item} {
  782.     global currFileSet tagFile
  783.     if {$currFileSet != $item} {
  784.     set old $currFileSet
  785.     set currFileSet $item
  786.     hook::callAll fileset-current * $old $currFileSet
  787.     }
  788.     # Bring in the tags file for this fileset
  789.     set fname [tagFileName]
  790.     if {[file exists $fname]} {
  791.     if {[dialog::yesno "Use tag file from folder \"$dir\" ?"]} {
  792.         set tagFile $fname
  793.     }
  794.     }
  795. }
  796.  
  797. # ◊◊◊◊ Open an item in a fileset ◊◊◊◊ #
  798.  
  799. proc fileset::openItemProc {fset parent item} {
  800.     global gfileSetsType 
  801.     if {$fset != ""} {set m $fset} else { set m $parent}
  802.     # try a type-specific method first
  803.     set proc fileset::$gfileSetsType($m)::selected
  804.     if {[info commands $proc] == "" && (![auto_load $proc])} {
  805.     # if that failed then just hope it's an ordinary list
  806.     if {![catch {filesetBasicOpen $m $item} err]} {return}
  807.     } else {
  808.     if {[llength [info args $proc]] == 2} {
  809.         if {![catch {eval [list $proc $parent $item]} err]} {return}
  810.     } else {
  811.         if {![catch {eval [list $proc $fset $parent $item]} err]} {return}
  812.     }
  813.     }
  814.     
  815.     fileset::fileNotFound $fset $err
  816. }
  817.  
  818. proc fileset::fileNotFound {fset {text ""}} {
  819.     if {[string length $text]} {
  820.     append text "\r"
  821.     }
  822.     append text "That file wasn't found. The fileset may be out of date."
  823.     if {![catch {dialog::yesno -y "Rebuild fileset" \
  824.       -n "Edit fileset" -c $text} res]} {
  825.     if {$res} {
  826.         updateAFileset $fset
  827.     } else {
  828.         editAFileset $fset
  829.     }
  830.     return 1
  831.     } else {
  832.     message "Cancelled"
  833.     return 0
  834.     }
  835. }
  836.  
  837. proc filesetBasicOpen {fset item} {
  838.     set f [file::pathEndsWith $item [getFilesInSet $fset]]
  839.     if {[string length $f]} {
  840.     autoUpdateFileset $fset
  841.     file::openAny $f
  842.     return
  843.     }
  844.     error "File for selected '$item' not found"
  845. }
  846.  
  847. proc autoUpdateFileset { name } {
  848.     global currFileSet filesetmodeVars
  849.     if {$filesetmodeVars(autoAdjustFileset)} {
  850.     changeFileSet $name
  851.     }
  852. }
  853.  
  854. # ◊◊◊◊ Query procs ◊◊◊◊ #
  855.  
  856. proc fileset::findForFile { {win ""} } {
  857.     if {$win == ""} { set win [win::Current] }
  858.     global currFileSet gfileSets gfileSetsType
  859.     foreach fset [concat [list $currFileSet] [array names gfileSets]] {
  860.     switch -- [fileset::getKind $gfileSetsType($fset)] {
  861.         "list" {
  862.         if {[lsearch -exact $gfileSets($fset) $win] != -1} {
  863.             return $fset
  864.         }
  865.         }
  866.         "glob" {
  867.         if {[file::pathStartsWith $win [file dirname $gfileSets($fset)]]} {
  868.             return $fset
  869.         }
  870.         }
  871.         "procedural" {
  872.         switch -- $gfileSetsType($fset) {
  873.             "recurseIn" {
  874.             if {[file::pathStartsWith $win [file dirname $gfileSets($fset)]]} {
  875.                 return $fset
  876.             }
  877.             }
  878.             default {
  879.             continue
  880.             }
  881.         }
  882.         }
  883.         "fromHierarchy" {
  884.         if {[file::pathStartsWith $win [file dirname [lindex $gfileSets($fset) 0]]]} {
  885.             return $fset
  886.         }
  887.         }
  888.         "default" {
  889.         # Not sure what this is for in this procedure.
  890.         global fileSets
  891.         if {[lsearch -exact $fileSets($fset) $win] != -1} {
  892.             return $fset
  893.         }
  894.         }
  895.     }
  896.     }
  897.     return ""
  898. }
  899.  
  900. proc dirtyFileset { fset } {
  901.     foreach f [getFilesInSet $fset] {
  902.     if { ![catch {getWinInfo -w $f arr}] && $arr(dirty)} { return 1 }
  903.     }
  904.     return 0
  905. }
  906.  
  907. proc isWindowInFileset { {win "" } {type ""} } {
  908.     if {$win == ""} { set win [win::Current] }
  909.     global currFileSet gfileSets gfileSetsType
  910.     
  911.     if { $type == "" } {
  912.     set okSets [array names gfileSets]
  913.     } else {
  914.     set okSets {}
  915.     foreach s [array names gfileSets] {
  916.         if { $gfileSetsType($s) == $type } {
  917.         lappend okSets $s
  918.         }
  919.     }
  920.     }
  921.     
  922.     if {[array exists gfileSets]} {
  923.     if {[lsearch -exact $okSets $currFileSet] != -1 } {
  924.         # check current fileset
  925.         if {[isWindowInFilelist $win [getFilesInSet $currFileSet]]} {
  926.         # we're set, it's in this fileset
  927.         return  $currFileSet
  928.         }
  929.     }
  930.     
  931.     # check other fileset
  932.     foreach fset $okSets {
  933.         if {[isWindowInFilelist $win [getFilesInSet $fset]]} {
  934.         # we're set, it's in this project
  935.         return  $fset
  936.         }
  937.     }   
  938.     }
  939.     return ""
  940.     
  941. }
  942.  
  943. if {[info tclversion] < 8.0} {
  944.     proc isWindowInFilelist { win flist } {
  945.     set win [win::StripCount $win]
  946.     if {[lsearch -exact $flist $win] != -1 } {
  947.         return 1
  948.     } else {
  949.         return 0
  950.     }
  951.     }
  952. } else {
  953.     proc isWindowInFilelist { win flist } {
  954.     set win [win::StripCount $win]
  955.     foreach f $flist {
  956.         if {[string equal $win [file::ensureStandardPath $f]]} {
  957.         return 1
  958.         }
  959.     }
  960.     return 0
  961.     }
  962. }
  963.  
  964. ## 
  965.  # -------------------------------------------------------------------------
  966.  #     
  967.  #    "pickFileset" --
  968.  #    
  969.  # Ask the user for a/several filesets.  If 'fset' is set, we just return
  970.  # that (this avoids 'if {$fset != ""} { set fset [pick...]  } constructs
  971.  # everywhere).  A prompt can be given, and a dialog type (either a
  972.  # listpick, a pop-up menu, or a listpick with multiple selection), and
  973.  # extra items can be added to the list if desired. 
  974.  # -------------------------------------------------------------------------
  975.  ##
  976. proc pickFileset { fset {prompt Fileset?} {type "list"} {extras {}} } {
  977.     global gfileSets currFileSet
  978.     if {[array size gfileSets] == 0} {
  979.     error "There are no filesets currently defined"
  980.     }
  981.     if { $fset != "" } { return $fset }
  982.     switch -- $type {
  983.     "popup" {
  984.         set fset [eval [list prompt $prompt \
  985.           $currFileSet "FileSet:"] [lsort -ignore [array names gfileSets]]]
  986.         if {![info exists gfileSets($fset)]} { error "No such fileset" }
  987.         return $fset
  988.     }
  989.     "list" {
  990.         return [listpick -p $prompt -L $currFileSet \
  991.           [lsort -ignore [concat $extras [array names gfileSets]]]]
  992.     }
  993.     "multilist" {
  994.         return [listpick -p $prompt -l -L $currFileSet \
  995.           [lsort -ignore [concat $extras [array names gfileSets]]]]
  996.     }
  997.     "notbuiltin" {
  998.         global fileset::notChangeable
  999.         set choices [list]
  1000.         foreach fset [lsort -ignore [array names gfileSets]] {
  1001.         if {[lsearch -exact ${fileset::notChangeable} $fset] == -1} {
  1002.             lappend choices $fset
  1003.         }
  1004.         }
  1005.         if {[llength $choices]} {
  1006.         set item $currFileSet
  1007.         if {[lsearch -exact $choices $currFileSet] == -1} {
  1008.             set item [lindex $choices 0]
  1009.         }
  1010.         return [listpick -p $prompt -L $item \
  1011.           [lsort -ignore [concat $extras $choices]]]
  1012.         } else {
  1013.         return ""
  1014.         }
  1015.     }
  1016.     "editable" {
  1017.         set choices [list]
  1018.         foreach fset [lsort -ignore [array names gfileSets]] {
  1019.         set canEdit [fileset::canEdit $fset]
  1020.         if {$canEdit < 0} {continue}
  1021.         lappend choices $fset
  1022.         }
  1023.         if {[llength $choices]} {
  1024.         set item $currFileSet
  1025.         if {[lsearch -exact $choices $currFileSet] == -1} {
  1026.             set item [lindex $choices 0]
  1027.         }
  1028.         return [listpick -p $prompt -L $item \
  1029.           [lsort -ignore [concat $extras $choices]]]
  1030.         } else {
  1031.         return ""
  1032.         }
  1033.     }
  1034.     }
  1035. }
  1036.  
  1037. # ◊◊◊◊ Tags ◊◊◊◊ #
  1038.  
  1039. if {![string length [info commands alphaFindTag]]} {
  1040.     rename findTag alphaFindTag
  1041.     rename createTagFile alphaCreateTagFile
  1042. }
  1043.  
  1044. proc tagFileName {} {
  1045.     global gfileSets currFileSet 
  1046.     return [file join [file dirname [lindex $gfileSets($currFileSet) 0]] "[join ${currFileSet}]TAGS"]
  1047. }
  1048.  
  1049. proc findTag {} {
  1050.     global gfileSetsType currFileSet
  1051.     # try a type-specific method first
  1052.     if {[catch {fileset::$gfileSetsType($currFileSet)::findTag}]} {
  1053.     alphaFindTag
  1054.     }
  1055. }
  1056.  
  1057. proc createTagFile {} {
  1058.     global gfileSetsType currFileSet tagFile modifiedVars
  1059.     set tagFile [tagFileName]
  1060.     lappend modifiedVars tagFile
  1061.     
  1062.     # try a type-specific method first
  1063.     if {[catch {fileset::$gfileSetsType($currFileSet)::createTagFile}]} {
  1064.     alphaCreateTagFile
  1065.     }
  1066. }
  1067.  
  1068. # ◊◊◊◊ Called by Alpha's core ◊◊◊◊ #
  1069.  
  1070. # Called from Alpha to get list of files for current file set.
  1071. proc getCurrFileSet {} {
  1072.     global currFileSet
  1073.     return [getFileSet $currFileSet]
  1074. }
  1075.  
  1076. # Called from Alpha to get names.  The first name returned is taken to
  1077. # be the current fileset.  For Alpha < 8.0, the list returned contains
  1078. # the first item twice (as the first item, and then in its correct 
  1079. # position in the list).  For Alpha >= 8.0 this silly behaviour has 
  1080. # been removed.
  1081. proc getFileSetNames {{ordered 0}} {
  1082.     global gfileSets currFileSet gDirScan
  1083.     set perm {}
  1084.     if {!$ordered && $currFileSet != ""} {
  1085.     lappend perm $currFileSet
  1086.     }
  1087.     foreach n [lsort -ignore [array names gfileSets]] {
  1088.     if {!$ordered && ([info tclversion] >= 8.0) && $n == $currFileSet} {continue}
  1089.     if {[info exists gDirScan($n)]} {
  1090.         lappend temp $n
  1091.     } else {
  1092.         lappend perm $n
  1093.     }
  1094.     }
  1095.     if {[info exists temp]} {
  1096.     return [concat $perm - $temp]
  1097.     } else {
  1098.     return $perm
  1099.     }
  1100. }
  1101.  
  1102. #================================================================================
  1103. # Edit a file from a fileset via list dialogs (no mousing around).
  1104. #================================================================================
  1105.  
  1106. namespace eval file {} 
  1107.  
  1108. proc file::openViaFileset {{fset ""}} {
  1109.     global currFileSet gfileSetsType file::separator
  1110.     
  1111.     if {[catch {pickFileset $fset {Fileset?} "list"} fset]} {return}
  1112.     set currFileSet $fset
  1113.     
  1114.     if {[info tclversion] < 8.0} {
  1115.     set cmd fileset::$gfileSetsType($fset)::getRoot
  1116.     } else {
  1117.     set cmd ::fileset::$gfileSetsType($fset)::getRoot
  1118.     }
  1119.     if {[llength [info commands $cmd]] || [auto_load $cmd]} {
  1120.     set filename [fileset::$gfileSetsType($fset)::getRoot $fset]
  1121.     while {[file isdirectory $filename]} {
  1122.         set disp [list]
  1123.         foreach f [glob -dir $filename *] {
  1124.         lappend disp [file tail $f]
  1125.         }
  1126.         set disp [concat [list ..] [lsort -ignore $disp]]
  1127.         if {[catch {listpick -p {File?} $disp} choice]} {return}
  1128.         if {$choice == ".."} {
  1129.         set filename [file dirname $filename]
  1130.         } else {
  1131.         set filename [file join $filename $choice]
  1132.         }
  1133.     }
  1134.     edit $filename
  1135.     } else {
  1136.     set allfiles [getFilesInSet $fset]
  1137.     foreach f $allfiles {
  1138.         lappend disp [file tail $f]
  1139.     }
  1140.     if {[catch {listpick -l -p {File?} [lsort -ignore $disp]} files]} {return}
  1141.     foreach res $files {
  1142.         set ind [lsearch -glob $allfiles "\*${file::separator}[quote::Find $res]"]
  1143.         fileset::openItemProc $fset "" [lindex $allfiles $ind]
  1144.     }
  1145.     }
  1146. }
  1147.  
  1148. # We only return TEXT files, since we don't want Alpha
  1149. # manipulating the data fork of non-text files.
  1150. proc getFileSet {fset} {
  1151.     global filesetmodeVars
  1152.     if {$filesetmodeVars(includeNonTextFiles)} {
  1153.     set fnames ""
  1154.     foreach f [getFilesInSet $fset] {
  1155.         if {[file isfile $f]} {
  1156.         getFileInfo $f a
  1157.         if {$a(type) == "TEXT"} {
  1158.             lappend fnames $f
  1159.         }
  1160.         }
  1161.     }
  1162.     return $fnames
  1163.     } else {
  1164.     return [getFilesInSet $fset]
  1165.     }
  1166. }
  1167.  
  1168.